home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / sdimage.com / RANDBOX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-14  |  2.7 KB  |  108 lines
  1.  
  2. {a quick little demo program to show the use of SDImage}
  3. {written by Michael Day 14 February 1989}
  4. {released to the public domain}
  5. {for best performance the IMG files should be directed to a RAM disk}
  6.  
  7. program randbox;
  8.  
  9. uses crt,graph,sdimage;
  10.  
  11. var
  12.     gr,gd:integer;
  13.     ch : char;
  14.     IT,screennum:integer;
  15.     x1,y1,x2,y2:integer;
  16.     StyleIt : integer;
  17.     im:pointer;
  18.  
  19. function fstr(i:integer):string;
  20. var s:string;
  21. begin
  22.   str(i,s);
  23.   fstr := s;
  24. end;
  25.  
  26. procedure bomb(I:integer);  {rats! show what went wrong}
  27. begin
  28.   setfillstyle(solidfill,black);
  29.   bar(0,0,100,10);
  30.   setcolor(green);
  31.   moveto(0,0);
  32.   outtext('OOPS!:'+fstr(i)+':'+fstr(ImageError));
  33.   Halt;
  34. end;
  35.  
  36.  
  37. {--------------------------------------------}
  38. {here is where it all begins}
  39.  
  40. begin
  41.   gr := 0;
  42.   gd := 0;
  43.   initgraph(gr,gd,'');
  44.   setfillstyle(xhatchfill,white); {now clear the dispay}
  45.   bar(0,0,GetMaxX,GetMaxY);
  46.   setColor(white);
  47.  
  48. { if you want to change the IMG path (such as to a ram disk) do it here}
  49. {  if not(SetImagePath('F:\SDI')) then bomb(6); }
  50.  
  51.   {this allows you to change the buffer size}
  52.   {if you want to see how it affects things}
  53. { if not AllocImageBuf(1,1000) then Bomb(3); }
  54.  
  55.   screennum := 0;
  56. repeat
  57.     setfillstyle(solidfill,black); {now clear the dispay}
  58.     bar(0,GetMaxY-10,GetMaxX,GetMaxY);
  59.     setColor(white);
  60.     outtextxy(2,GetMaxY-8,'Screen: '+fstr(screennum));
  61.     inc(screennum);
  62.  
  63.   for IT := 0 to 7 do       {create the images}
  64.   begin
  65.  
  66.  
  67.     x1 := random(GetmaxX shr 1);            {defines the image area we will be using}
  68.     y1 := random(GetmaxY shr 1);
  69.     x2 := x1+random((GetmaxX shr 1)-80)+80;
  70.     y2 := y1+random((GetmaxY shr 1)-40)+40;
  71.  
  72.     StyleIt := IT or $10;
  73.     if not saveImage(IT,1, x1,y1,x2,y2, StyleIT) then bomb(1);
  74.  
  75. {to see the difference between a compressed and non-compressed file}
  76. {enable the following statements and examine the resulting IMG files}
  77. {after a couple runs.}
  78.  
  79. {
  80.     StyleIt := IT;
  81.     if not saveImage(IT+20,1, x1,y1,x2,y2, StyleIT) then bomb(1);
  82.  
  83.     StyleIt := IT or $10;
  84.     if not saveImage(IT+30,1, x1,y1,x2,y2, StyleIT) then bomb(1);
  85. }
  86.     setfillstyle(random(11)+1,random(14));
  87.     setcolor(random(14));
  88.  
  89.     bar(x1,y1,x2,y2);
  90.     rectangle(x1,y1,x2,y2);
  91.     setColor(white);
  92.     outtextxy(x1+2,y1+2,fstr(it));
  93.     outtextxy(x1+2,y1+10,fstr(x1)+' '+fstr(y1));
  94.     outtextxy(x1+2,y1+18,fstr(x2)+' '+fstr(y2));
  95.   end;
  96.  
  97.   for IT := 7 downto 0 do       {create the images}
  98.   begin
  99.     if not displayImage(IT,1, false) then bomb(2);
  100.   end;
  101.  
  102.   setColor(white);
  103.   ch := #255;
  104.   if keypressed then ch := readkey;  {stop when they tell us to}
  105. until ch < #32;
  106.  
  107. end.
  108.